home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0062_Voc Player!!!.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  7KB  |  321 lines

  1. {
  2. => A few days ago you posted a VOC file player that doesn't use CT-VOICE.DRV.
  3. => I would like to know how to use it.  So far I have tried this.
  4. => Uses PLAY;
  5. =>
  6. => Var A : Pointer;
  7. =>
  8. => Begin
  9. =>  PLAY_VOC('HI.VOC',A); End.
  10. => End.
  11. =>
  12. => Could you explain why this doesn't work and or give me a working demo!
  13.  
  14. You have to use "getmem" to reserve some memory before calling "play_voc".
  15. Here follows a slightly modified unit + demo...
  16.  
  17. Alwin Loeckx - fido (2:291/754.6)
  18. }
  19.  
  20. unit play;
  21.  
  22. interface
  23.  
  24. { resetdsp returns true if reset was successful }
  25. { base should be 1 for base address 210h, 2 for 220h etc... }
  26. function reset_dsp(base : word) : boolean;
  27.  
  28. { write dac sets the speaker output level }
  29. procedure write_dac(level : byte);
  30.  
  31. { readdac reads the microphone input level }
  32. function read_dac : byte;
  33.  
  34. { speakeron connects the dac to the speaker }
  35. function speaker_on: byte;
  36.  
  37. { speakeroff disconnects the dac from the speaker, }
  38. { but does not affect the dac operation }
  39. function speaker_off: byte;
  40.  
  41. { functions to pause dma playback }
  42. procedure dma_pause;
  43. procedure dma_continue;
  44.  
  45. { playback plays a sample of a given size back at a given frequency using }
  46. { dma channel 1. the sample must not cross a page boundry }
  47. procedure play_back(sound : pointer; size : word; frequency : word);
  48.  
  49. { plays voc-file }
  50. procedure play_voc(filename : string; buf : pointer);
  51.  
  52. { true if playing voc }
  53. function playing_voc : boolean;
  54.  
  55.  
  56. implementation
  57.  
  58. uses crt;
  59.  
  60. var dsp_reset        : word;
  61.     dsp_read_data    : word;
  62.     dsp_write_data   : word;
  63.     dsp_write_status : word;
  64.     dsp_data_avail   : word;
  65.  
  66.     since_midnight   : longint absolute $40:$6C;
  67.     playing_till     : longint;
  68.  
  69.  
  70. function reset_dsp(base : word) : boolean;
  71.  
  72. begin
  73.  base := base * $10;
  74.  
  75.  { calculate the port addresses }
  76.  dsp_reset        := base + $206;
  77.  dsp_read_data    := base + $20a;
  78.  dsp_write_data   := base + $20c;
  79.  dsp_write_status := base + $20c;
  80.  dsp_data_avail   := base + $20e;
  81.  
  82.  { reset the dsp, and give some nice long delays just to be safe }
  83.  port[dsp_reset] := 1;
  84.  delay(10);
  85.  
  86.  port[dsp_reset] := 0;
  87.  delay(10);
  88.  
  89.  reset_dsp := (port[dsp_data_avail] and $80 = $80) and
  90.               (port[dsp_read_data] = $aa);
  91. end;
  92.  
  93.  
  94. procedure write_dsp(value : byte);
  95.  
  96. begin
  97.  while port[dsp_write_status] and $80 <> 0 do;
  98.  port[dsp_write_data] := value;
  99. end;
  100.  
  101.  
  102. function read_dsp : byte;
  103.  
  104. begin
  105.  while port[dsp_data_avail] and $80 = 0 do;
  106.  read_dsp := port[dsp_read_data];
  107. end;
  108.  
  109.  
  110. procedure write_dac(level : byte);
  111.  
  112. begin
  113.  write_dsp($10);
  114.  write_dsp(level);
  115. end;
  116.  
  117.  
  118. function read_dac : byte;
  119.  
  120. begin
  121.  write_dsp($20);
  122.  read_dac := read_dsp;
  123. end;
  124.  
  125.  
  126. function speaker_on: byte;
  127.  
  128. begin
  129.  write_dsp($d1);
  130. end;
  131.  
  132.  
  133. function speaker_off: byte;
  134.  
  135. begin
  136.  write_dsp($d3);
  137. end;
  138.  
  139.  
  140. procedure dma_continue;
  141.  
  142. begin
  143.  playing_till := since_midnight + playing_till;
  144.  write_dsp($d4);
  145. end;
  146.  
  147.  
  148. procedure dma_pause;
  149.  
  150. begin
  151.  playing_till := playing_till - since_midnight;
  152.  write_dsp($d0);
  153. end;
  154.  
  155.  
  156. procedure play_back(sound : pointer; size : word; frequency : word);
  157.  
  158. var time_constant : word;
  159.     page          : word;
  160.     offset        : word;
  161.  
  162. begin
  163.  speaker_on;
  164.  
  165.  size := size - 1;
  166.  
  167.  { set up the dma chip }
  168.  offset := seg(sound^) shl 4 + ofs(sound^);
  169.  page := (seg(sound^) + ofs(sound^) shr 4) shr 12;
  170.  port[$0a] := 5;
  171.  port[$0c] := 0;
  172.  port[$0b] := $49;
  173.  port[$02] := lo(offset);
  174.  port[$02] := hi(offset);
  175.  port[$83] := page;
  176.  port[$03] := lo(size);
  177.  port[$03] := hi(size);
  178.  port[$0a] := 1;
  179.  
  180.  { set the playback frequency }
  181.  time_constant := 256 - 1000000 div frequency;
  182.  write_dsp($40);
  183.  write_dsp(time_constant);
  184.  
  185.  { set the playback type (8-bit) }
  186.  write_dsp($14);
  187.  write_dsp(lo(size));
  188.  write_dsp(hi(size));
  189. end;
  190.  
  191.  
  192.  
  193.  
  194. procedure play_voc(filename : string; buf : pointer);
  195.  
  196. var f : file;
  197.     s : word;
  198.  
  199.     freq : word;
  200.  
  201.     h : record
  202.          signature  : array[1..20] of char; { vendor's name }
  203.          data_start : word;                 { start of data in file }
  204.          version    : integer;              { min. driver version required }
  205.          id         : integer;              { 1 - complement of version field
  206. +$1234 }        end;                                { used to indentify a .voc
  207. file }
  208.     d : record
  209.          id   : byte;                { = 1 }
  210.          len  : array[1..3] of byte; { length of voice data (len data + 2) }
  211.          sr   : byte;                { sr = 256 - (1,000,000 / sampling rate) }
  212.          pack : byte;                { 0 : unpacked, 1 : 4-bit, 2 : 2.6 bit, 3:
  213. 2 bit packed }        end;
  214.  
  215. begin
  216.  {$i-}
  217.  if pos('.', filename) = 0 then filename := filename + '.voc';
  218.  
  219.  assign(f, filename);
  220.  reset(f, 1);
  221.  
  222.  blockread(f, h, 26);
  223.  
  224.  blockread(f, d, 6);
  225.  
  226.  freq := round(1000000 / (256 - d.sr));
  227.  s    := ord(d.len[3]) + ord(d.len[2]) * 256 + ord(d.len[1]) * 256 * 256;
  228.  
  229.  (*
  230.  writeln('-----------header----------');
  231.  writeln('signature: ', h.signature);
  232.  writeln('data_start: ', h.data_start);
  233.  writeln('version: ', hi(h.version), '.', lo(h.version));
  234.  writeln('id: ', h.id);
  235.  writeln;
  236.  writeln('------------data-----------');
  237.  writeln('id: ', d.id);
  238.  writeln('len: ', s);
  239.  writeln('sr: ', d.sr);
  240.  writeln('freq: ', freq);
  241.  writeln('pack: ', d.pack);
  242.  *)
  243.  
  244.  blockread(f, buf^, s);
  245.  
  246.  close(f);
  247.  {$i-}
  248.  
  249.  if ioresult <> 0 then
  250.   begin
  251.    writeln('Can''t find voc file "' + filename + '"');
  252.    halt(1);
  253.   end;
  254.  
  255.  playing_till := since_midnight + round(s / freq * 18.20648193);
  256.  play_back(buf, s, freq);
  257. end;
  258.  
  259.  
  260.  
  261. function playing_voc : boolean;
  262.  
  263. begin
  264.  playing_voc := since_midnight > playing_till;
  265. end;
  266.  
  267.  
  268.  
  269. begin
  270.  if not reset_dsp(2) then
  271.   begin
  272.    writeln('SoundBlaster not found at 220h');
  273.    halt(1);
  274.   end
  275.  else
  276.   writeln('SoundBlaster found at 220h');
  277. end.
  278.  
  279. { -----------------"demo.pas"------------------------------------------ }
  280.  
  281. uses crt, play;
  282.  
  283. var voc  : pointer;
  284.     name : string;
  285.  
  286. begin
  287.  getmem(voc, 65535);
  288.  
  289.  if paramcount = 1 then
  290.   name := paramstr(1)
  291.  else
  292.   begin
  293.    write('Play voc file (size < 65535!): ');
  294.    readln(name);
  295.   end;
  296.  
  297.  play_voc(name, voc);
  298.  writeln;
  299.  
  300.  writeln('Playing, press "P" to pause...');
  301.  
  302.  repeat
  303.   if keypressed then if (upcase(readkey) = 'P') then
  304.    begin
  305.     dma_pause;
  306.  
  307.     writeln('Press "C" to continue...');
  308.  
  309.     repeat
  310.     until upcase(readkey) = 'C';
  311.  
  312.     writeln('Continuing...');
  313.     dma_continue;
  314.    end;
  315.  until playing_voc;
  316.  
  317.  writeln('Done...');
  318.  
  319.  freemem(voc, 65535);
  320. end.
  321.